use Lingua::RU::OpenCorpora::Tokenizer;

use strict;
use utf8;

binmode(STDIN, ":encoding(utf-8)");
binmode(STDOUT, ":encoding(utf-8)");
binmode(STDERR, ":encoding(utf-8)");

my %XmlEntries = ('&' => 'amp', '"' => 'quot', "'" => 'apos', "<" => 'lt', ">" => 'gt');

my $tokenizer = Lingua::RU::OpenCorpora::Tokenizer->new;
my ($parid, $sentid, $tid) = (1, 1, 1);
my $forum_prefix = "forum.asi.ru";

$/ = "<hr class=\"divider\" />"; 
#viewtopic.php?f=4&t=102&start=20

my $dir = '../../../../dump/forum.asi.ru/';
opendir(DIR, $dir) or die $!;

print "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"yes\"?>\n";
print "<annotation version=\"0.1\" revision=\"1\">\n";

my %d;

while (my $file = readdir(DIR)) {

  if ($file =~ /^viewtopic\.php\?f=(\d+)&t=(\d+)/ && $file !~ /print$/) {
#  if ($file =~ /viewtopic\.php\?p=26650/) {
#   if ($file =~ /viewtopic\.php\?p=11526/) {
    my ($f, $t) = ($1, $2);
    if (4 != $f) { next; }
    open(F, "< $dir/$file") || die $!;
    binmode(F, ":encoding(utf-8)");
    while (<F>) {
      my @attr;
      my %h;
      my $x = parse_file(\$_, \@attr, $file, $f, $t, \%h);
      my $postid = $h{post_id};
      if (!exists($d{$f}->{$t}->{$postid})) {
        $d{$f}->{$t}->{$postid} = $x;
      } else {
        print STDERR "ERROR $f $t $postid is double\n";
      }
      print "$x\n";
    }
    close(F);
  } else {
    print STDERR "ERROR can't parse url = $file\n";
  }

#  if ($parid > 1000) { last; }
}

closedir(DIR);

foreach my $fid (sort {$a <=> $b} keys %d) {
  foreach my $tid (sort {$a <=> $b} keys %{$d{$fid}}) {
    foreach my $pid (sort {$a <=> $b} keys %{$d{$fid}->{$tid}}) {
      print $d{$fid}->{$tid}->{$pid} . "\n";
    }
  }
}


print "</annotation>\n";
  
sub parse_file {
  my ($rraw, $rattr, $fn, $forum_id, $topic_id, $rh) = @_;
  my %h;
  if ($$rraw =~ /<p class="author"><a href=\"([^\"]+)\".*?<a href=\"([^\"]+)\">([^<]+)<\/a>/) {
    ($h{post_url}, $h{author_url}, $h{author_nick}) = ($1, $2, $3);
    if ($h{author_url} =~ /u=(\d+)$/) {
      $h{author_id} = $1;
      $h{author_url} =~ s/^.\///;
      push @{$rattr}, "Автор:url:http://$forum_prefix/" . $h{author_url};
      push @{$rattr}, "Автор:id:" . $h{author_id};
      push @{$rattr}, "Автор:" . $h{author_nick};
    }
    $h{post_url} =~ s/^\.\///;
    push @{$rattr}, "url:http://$forum_prefix/" . $h{post_url};
    if ($h{post_url} =~ /#p(\d+)$/ || $h{post_url} =~ /p=(\d+)$/) {
      $h{post_id} = $1;
    } else {
      print STDERR "ERROR: no post_id: $h{post_url}\n";
    }
  } else {
    print STDERR "ERROR: can't parse $$rraw\n";
    return "";
  }

  if ($$rraw =~ /<div class="content">(.*?)<dl class="postprofile"/s) {
    $h{raw} = $1;
    $h{raw} =~ s/<br \/>/\n/sg;
    $h{raw} =~ s/<span style=\"[^\"]*\">//sg;
    $h{raw} =~ s/<\/span>//sg;
    $h{raw} =~ s/<img[^>]*>//sg;

    $h{raw} =~ s/<!-- [mlwe] -->/ /sg;
    $h{raw} =~ s/<a [^\>]*?href=\"([^\"]+)\"[^\>]*?>[^<]*<\/a>/ $1 /sg;
    $h{raw} =~ s/<\/a>//sg;
 
    while ($h{raw} =~ s/<blockquote[^<]*?><div><cite>[^<]*?<\/cite>[^<]*?<\/div><\/blockquote>//sg) {
    }
    while ($h{raw} =~ s/<blockquote[^<]*?>[^<]*?<\/blockquote>//sg) {
    }
   
    $h{raw} =~ s/<.?blockquote[^<]*?>//sg;
 
    $h{raw} =~ s/<div class="notice">.*?<\/div>//sg;
    $h{raw} =~ s/<div [^>]*?class="signature">[^<]*?<\/div>//sg;
    $h{raw} =~ s/<br \/>/\n/sg;
    $h{raw} =~ s/<\/div>//sg;
    $h{raw} =~ s/<div[^>]*?>//sg;
    $h{raw} =~ s/\n\s*\n//sg;
    $h{raw} =~ s/^\n//;
    $h{raw} =~ s/&quot;/\"/sg;
    $h{raw} =~ s/\x{0019}//sg;
    $h{raw} =~ s/\x{000B}//sg;

    # Совсем непонятные вещи тоже убиваем и складываем в список ошибок
    $h{raw} =~ s/<([^>]+)>//sg;
    print STDERR "ERROR: UNKNOWN TAG " . $1 . "\n";

    print STDERR $h{raw} . "\n";
  }

  %{$rh} = %h;
  my $x = make_xml_text($topic_id, $h{post_id}, "", $rattr, \$h{raw});
  
}

sub make_xml_text {
  my ($pid, $id, $name, $rat, $rt) = @_;
  my $x;

  $x .= "<text id=\"$id\" parent=\"$pid\" name=\"$name\">\n";
  $x .= "  <tags>\n";
  foreach my $t (@{$rat}) {
    $x .= "    <tag>$t</tag>\n";
  }
  $x .= "  </tags>\n";
  
  $x .= "  <paragraphs>\n";
  my @par = split(/\n+/, $$rt);
  foreach my $p (@par) {
    $x .= "    <paragraph id=\"$parid\">\n";
    $p =~ s/([\.\!\?])\s+([A-ZА-ЯЁ])/$1 SENTBREAK $2/sg;
    my @sent = split(/ SENTBREAK /, $p);
    foreach my $s (@sent) {
      $s =~ s/^\s+//;
      $s =~ s/\s+$//;
      $x .= "      <sentence id=\"$sentid\">\n";
      $x .= "        <source>$s</source>\n";
      
      #do tokenization
      $x .= "        <tokens>\n";

      my $tokens = $tokenizer->tokens($s, {threshold => 0.5});
      foreach my $t (@{$tokens}) {
        $t = encode_xml_char($t);
        $x .= "          <token id=\"$tid\" text=\"$t\">";
        $x .= "<tfr rev_id=\"1\" t=\"$t\"><v><l id=\"0\" t=\"$t\"><g v=\"UNKN\"/></l></v></tfr></token>\n";
        $tid += 1;
      }

      $x .= "        </tokens>\n";
      $x .= "      </sentence>\n";
      $sentid += 1;
    }

    $x .= "    </paragraph>\n";
    $parid += 1;
  } 
  $x .= "  </paragraphs>\n";
  $x .= "</text>\n";

  return $x;
}

sub encode_xml_char {
  my $s = shift;
  $s =~ s/([&"'<>])/&$XmlEntries{$1};/g;
  return $s;
}
